home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0514.ZIP / CRAYZ15.ARC / VCODR.PAS < prev    next >
Pascal/Delphi Source File  |  1986-08-01  |  4KB  |  99 lines
  1. { Copyright (C) 1986 Adam Fritz, 133 Main St., Afton, NY 13730 }
  2.  
  3. program main ;
  4.  
  5.      { Program: LINPACK SGECO and SGEFA Test Driver.       }
  6.      {                                                     }
  7.      { Version:                 Date:                      }
  8.      {                                                     }
  9.      {    1.5/TURBO Pascal 3.0     08/02/86                }
  10.      {                                                     }
  11.      { Description:                                        }
  12.      {                                                     }
  13.      {    Uses LINPACK SGECO and SGEFA to compute          }
  14.      {    condition estimate RCond for matrices.           }
  15.      {    A is set up as a Hilbert matrix of specified     }
  16.      {    order and SGECO is called to compute the RCond   }
  17.      {    measure.  If PrintCode <> 0 then printout will   }
  18.      {    include RCond and 'folded' RCond where;          }
  19.      {       folded RCond = (1.0+RCond)-1.0                }
  20.      {                                                     }
  21.      { Author:                                             }
  22.      {                                                     }
  23.      {    Adam Fritz                                       }
  24.      {    133 Main Street                                  }
  25.      {    Afton, New York 13730                            }
  26.  
  27. {-I DizZ.con                    CONSTANT Declarations      }
  28. {-I DizZ.typ                    TYPE Declarations          }
  29. {-I DizZ.var                    VARIABLE Declarations      }
  30. {$I CrayZ.con                   CONSTANT Declarations      }
  31. {$I CrayZ.typ                   TYPE Declarations          }
  32. {$I CrayZ.var                   VARIABLE Declarations      }
  33.  
  34.      aaID           : vARRAY ;
  35.      i, j           : integer ;
  36.  
  37. {-I DizZ.pas                    Vector Read/Write Routines }
  38. {$I DrivZ.pas                   Vector Read/Write Routines }
  39.  
  40. {-I CGen.pas                    Test System Generator      }
  41. {$I HilGen.pas                  Test System Generator      }
  42. {-I VectScal.p                  MathPak (C) Routine Package }
  43. {-I SkipVS.p                    MathPak (C) Routine Package }
  44. {-I mpBLAS.pas                  MathPak (C) BLAS           }
  45. {$I BLAS.pas                    Basic Linear Algebra       }
  46. {$I vSGEFA.pas                  LINPACK Factor             }
  47. {$I vSGETP.pas                  Virtual Array Transpose    }
  48. {$I vSGECO.pas                  LINPACK Condition          }
  49. {$I vOUT.pas                    Virtual Array Output       }
  50. {$I OUT.pas                     SICE Output Routine        }
  51.  
  52. begin
  53.                                 { Initialize }
  54.    writeln('LINPACK SGECO and SGEFA Test Program, CrayZ Version 1.5.') ;
  55.    writeln ;
  56.                                 { Get Order }
  57.    n := 0 ;
  58.    while (n < 1) or (n > lda) do begin
  59.       write('Order: ') ;
  60.       readln(n)
  61.    end ;
  62.                                 { Allocate Matrix        }
  63.    vCreate (aID,'aMATRIX.$$$',n) ;
  64.                                 { Get Print Code }
  65.    write('Print Code: ') ;
  66.    readln (PrintCode) ;
  67.                                 { Generate Test System }
  68.    SYSGEN (aID, lda, n, b) ;
  69.    if PrintCode > 0 then begin
  70.       writeln ;
  71.       writeln('Original System (by column):') ;
  72.       writeln ;
  73.       vOUT (aID, n) ;
  74.       OUT (b[1], lda, n, 1)
  75.    end ;
  76.                                 { Allocate Transpose Matrix. }
  77.    vCreate (aaID,'aaMATRIX.$$$',n) ;
  78.                                 { Fill Transpose Matrix.  }
  79.    for i := 1 to n do
  80.       Aj[i] := 0.0 ;
  81.    for j := 1 to n do
  82.       VectorWrite (aaID,n,1,j,n,Aj) ;
  83.                                 { Compute the Condition }
  84.    vSGECO (aID, aaID, lda, n, IPvt, RCond, Work) ;
  85.    writeln ;
  86.    write('RCond: ',RCond:14) ;
  87.    RCond := (1.0 + RCond) - 1.0 ;
  88.    writeln(', RCond: ',RCond:14) ;
  89.    writeln ;
  90.                                 { Close }
  91.    vClose (aaID) ;
  92.    vClose (aID) ;
  93.                                 { Done }
  94.    writeln('End of Test.')
  95.  
  96. end.
  97.  
  98. { Copyright (C) 1986 Adam Fritz, 133 Main St., Afton, NY 13730 }
  99.